SRCD 2019 Symposium: Religious & metaphysical concepts (Srinivasan)

# load required libraries
library(tidyverse)
library(langcog) # source: https://github.com/langcog/langcog-package
library(psych)
library(lme4)
library(cowplot)
# set theme for ggplots
theme_set(theme_bw())

Data preparation

d_all <- bind_rows(d_us_ad %>% rownames_to_column("subid"), 
                   d_us_ch %>% rownames_to_column("subid"),
                   d_gh_ad %>% rownames_to_column("subid"), 
                   d_gh_ch_fante %>% rownames_to_column("subid"),
                   d_th_ad %>% rownames_to_column("subid"), 
                   d_th_ch %>% rownames_to_column("subid"),
                   d_vt_ad %>% rownames_to_column("subid"), 
                   d_vt_ch %>% rownames_to_column("subid")) %>%
  column_to_rownames("subid")

Shared conceptual structure

Pooling all participants from all sites together into a common factor structure.

Parallel analysis

How many factors to retain?

reten_all_PA <- fa.parallel(d_all, plot = F); reten_all_PA

Parallel analysis suggests that the number of factors =  4  and the number of components =  3 
Call: fa.parallel(x = d_all, plot = F)
Parallel analysis suggests that the number of factors =  4  and the number of components =  3 

 Eigen Values of 

reten_all_par <- reten_all_PA$nfact

What are these factors?

efa_all_par <- fa(d_all, nfactors = reten_all_par, rotate = "varimax",
                  scores = "tenBerge", impute = "median")
efa_all_par_factornames <- c("[other]", "BODILY", 
                             "SOCIAL-EMOTIONAL", "COGNITIVE")
efa_all_par_factornames_short <- c("[other]", "BOD.", 
                                   "SOC.-EMO.", "COG.")

heatmap_fun(efa_all_par, factor_names = efa_all_par_factornames) +
  labs(title = "Factor loadings (data pooled across all samples)")

the condition has length > 1 and only the first element will be usedJoining, by = "capacity"
Joining, by = "factor"

Which capacities are attributed to which targets?

Factor scores

scoresplot_fun(efa_all_par, target = "all",
               factor_names = efa_all_par_factornames) + 
  labs(title = "Factor scores (by sample, factor, and target entity)",
       subtitle = "All targets")

the condition has length > 1 and only the first element will be used

|==============================                    | 61% ~1 s remaining     
|==============================                    | 62% ~1 s remaining     
|================================                  | 64% ~1 s remaining     
|=================================                 | 67% ~1 s remaining     
|==================================                | 70% ~1 s remaining     
|===================================               | 72% ~1 s remaining     
|=====================================             | 75% ~1 s remaining     
|======================================            | 77% ~1 s remaining     
|=======================================           | 79% ~1 s remaining     
|========================================          | 80% ~1 s remaining     
|========================================          | 82% ~1 s remaining     
|=========================================         | 83% ~1 s remaining     
|==========================================        | 85% ~0 s remaining     
|===========================================       | 87% ~0 s remaining     
|============================================      | 89% ~0 s remaining     
|=============================================     | 92% ~0 s remaining     
|==============================================    | 93% ~0 s remaining     
|================================================  | 96% ~0 s remaining     
|================================================= | 98% ~0 s remaining     

Ignoring unknown aesthetics: y

scoresplot_fun(efa_all_par, target = c("ghosts", "God", "children"),
               factor_names = efa_all_par_factornames_short) + 
  labs(title = "Factor scores (by sample, factor, and target entity)",
       subtitle = "Human and 'supernatural' targets only")

the condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedIgnoring unknown aesthetics: y

itemsplot_fun(efa_all_par, target = c("ghosts", "God", "children")) +
  labs(title = "Parallel Analysis")

the condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedJoining, by = "capacity"

|======================                            | 45% ~2 s remaining     
|=======================                           | 46% ~2 s remaining     
|=======================                           | 46% ~2 s remaining     
|=======================                           | 47% ~2 s remaining     
|=======================                           | 48% ~2 s remaining     
|========================                          | 48% ~2 s remaining     
|========================                          | 49% ~2 s remaining     
|========================                          | 50% ~2 s remaining     
|=========================                         | 50% ~2 s remaining     
|=========================                         | 51% ~2 s remaining     
|=========================                         | 52% ~2 s remaining     
|==========================                        | 52% ~2 s remaining     
|==========================                        | 53% ~2 s remaining     
|==========================                        | 53% ~2 s remaining     
|==========================                        | 54% ~2 s remaining     
|===========================                       | 54% ~2 s remaining     
|===========================                       | 55% ~2 s remaining     
|===========================                       | 56% ~2 s remaining     
|============================                      | 56% ~2 s remaining     
|============================                      | 57% ~2 s remaining     
|============================                      | 58% ~2 s remaining     
|=============================                     | 58% ~2 s remaining     
|=============================                     | 59% ~2 s remaining     
|=============================                     | 60% ~2 s remaining     
|==============================                    | 60% ~2 s remaining     
|==============================                    | 61% ~2 s remaining     
|==============================                    | 62% ~2 s remaining     
|===============================                   | 62% ~2 s remaining     
|===============================                   | 63% ~2 s remaining     
|================================                  | 64% ~2 s remaining     
|================================                  | 64% ~2 s remaining     
|================================                  | 65% ~2 s remaining     
|================================                  | 66% ~2 s remaining     
|=================================                 | 66% ~2 s remaining     
|=================================                 | 67% ~2 s remaining     
|=================================                 | 68% ~2 s remaining     
|==================================                | 68% ~2 s remaining     
|==================================                | 69% ~2 s remaining     
|==================================                | 70% ~2 s remaining     
|===================================               | 70% ~2 s remaining     
|===================================               | 71% ~2 s remaining     
|===================================               | 72% ~2 s remaining     
|====================================              | 73% ~2 s remaining     
|====================================              | 73% ~2 s remaining     
|=====================================             | 74% ~2 s remaining     
|=====================================             | 75% ~2 s remaining     
|=====================================             | 76% ~2 s remaining     
|======================================            | 76% ~2 s remaining     
|======================================            | 77% ~1 s remaining     
|======================================            | 78% ~1 s remaining     
|=======================================           | 78% ~1 s remaining     
|=======================================           | 79% ~1 s remaining     
|========================================          | 80% ~1 s remaining     
|========================================          | 81% ~1 s remaining     
|========================================          | 81% ~1 s remaining     
|=========================================         | 82% ~1 s remaining     
|=========================================         | 82% ~1 s remaining     
|=========================================         | 83% ~1 s remaining     
|=========================================         | 83% ~1 s remaining     
|==========================================        | 84% ~1 s remaining     
|==========================================        | 85% ~1 s remaining     
|==========================================        | 85% ~1 s remaining     
|==========================================        | 86% ~1 s remaining     
|===========================================       | 86% ~1 s remaining     
|===========================================       | 87% ~1 s remaining     
|============================================      | 88% ~1 s remaining     
|============================================      | 89% ~1 s remaining     
|============================================      | 90% ~1 s remaining     
|=============================================     | 91% ~1 s remaining     
|=============================================     | 91% ~1 s remaining     
|==============================================    | 92% ~1 s remaining     
|==============================================    | 93% ~0 s remaining     
|==============================================    | 93% ~0 s remaining     
|===============================================   | 94% ~0 s remaining     
|===============================================   | 95% ~0 s remaining     
|===============================================   | 95% ~0 s remaining     
|================================================  | 96% ~0 s remaining     
|================================================  | 97% ~0 s remaining     
|================================================  | 98% ~0 s remaining     
|================================================= | 98% ~0 s remaining     
|================================================= | 99% ~0 s remaining     
|==================================================|100% ~0 s remaining     

Joining, by = c("factor", "capacity", "order")

Summary scores

factors_par <- efa_all_par$loadings[] %>%
  data.frame() %>%
  rownames_to_column("capacity") %>%
  gather(factor, loading, -capacity) %>%
  group_by(capacity) %>%
  top_n(1, loading) %>%
  ungroup() %>%
  arrange(factor, desc(loading)) %>%
  mutate(order = 1:nrow(.),
         factor = factor(factor,
                         levels = paste0("MR", 1:efa_all_par$factors),
                         labels = efa_all_par_factornames),
         factor = factor(as.character(factor)))
# factors_par_howmany <- factors_par %>%
#   count(factor)
# factors_par_howmany <- min(factors_par_howmany$n)
factors_par_howmany <- 6
factors_par_culled <- factors_par %>%
  group_by(factor) %>%
  top_n(factors_par_howmany, loading) %>%
  ungroup() %>%
  arrange(factor, desc(loading)) %>%
  mutate(order = 1:nrow(.))
scores_par_prelim <- d_all %>%
  rownames_to_column("site_age_subid_target_entity") %>%
  gather(capacity, response, -site_age_subid_target_entity) %>%
  mutate(site = gsub("_.*$", "", site_age_subid_target_entity),
         age = gsub("_.*$", "", gsub("^.._", "", site_age_subid_target_entity)),
         subid = gsub("_target.*$", "", site_age_subid_target_entity),
         target = gsub("^.*target_", "", site_age_subid_target_entity)) %>%
  mutate(target = case_when(target == "pigs" ~ NA_character_,
                            target == "NA" ~ NA_character_,
                            target == "crickets" ~ "beetles",
                            TRUE ~ target)) %>%
  mutate(site = factor(site, levels = c("us", "gh", "th", "ch", "vt"),
                       labels = c("US", "Ghana", "Thailand", 
                                  "China", "Vanuatu")),
         age = factor(age, levels = c("ad", "ch"),
                      labels = c("adults", "children")),
         target = factor(target,
                         levels = c("rocks", "flowers", "cell phones", 
                                    "beetles", "chickens", "mice", 
                                    "dogs", "children", "ghosts", "God"))) %>%
  select(-site_age_subid_target_entity) %>%
  full_join(factors_par_culled) %>%
  # full_join(factors_par) %>%
  filter(!is.na(target), !is.na(factor)) %>%
  distinct()

Joining, by = "capacity"

scores_par <- scores_par_prelim %>%
  group_by(site, age, subid, target, factor) %>%
  summarise(score = mean(response, na.rm = T)) %>%
  ungroup()
scores_par_mb <- scores_par %>% 
  group_by(site, age, target, factor) %>%
  multi_boot_standard(col = "score", na.rm = T) %>%
  ungroup()

|====================================              | 73% ~1 s remaining     
|=====================================             | 75% ~1 s remaining     
|======================================            | 77% ~1 s remaining     
|=======================================           | 79% ~1 s remaining     
|========================================          | 80% ~1 s remaining     
|=========================================         | 82% ~1 s remaining     
|==========================================        | 84% ~0 s remaining     
|===========================================       | 86% ~0 s remaining     
|===========================================       | 88% ~0 s remaining     
|============================================      | 89% ~0 s remaining     
|=============================================     | 91% ~0 s remaining     
|==============================================    | 92% ~0 s remaining     
|==============================================    | 93% ~0 s remaining     
|===============================================   | 95% ~0 s remaining     
|================================================  | 98% ~0 s remaining     
|================================================= | 99% ~0 s remaining     

# calculate reliability
scores_par_prelim_wide <- scores_par_prelim %>%
  full_join(factors_par_culled) %>%
  filter(!is.na(factor), !is.na(subid)) %>% 
  arrange(factor, desc(loading)) %>%
  select(subid, capacity, response) %>%
  spread(capacity, response) %>%
  select(subid, factors_par_culled$capacity) %>%
  column_to_rownames("subid")

Joining, by = c("capacity", "factor", "loading", "order")

# BODILY
paste(names(scores_par_prelim_wide[1:6]), collapse = ", ")

[1] "get hungry, feel pain, feel sick, like when you feel like you might vomit, feel tired, feel scared, smell things"

alpha(scores_par_prelim_wide[1:6])$total

# "COGNITIVE"
paste(names(scores_par_prelim_wide[7:12]), collapse = ", ")

[1] "remember things, figure out how to do things, choose what to do, think about things, sense when things are far away, hear things"

alpha(scores_par_prelim_wide[7:12])$total

# "SOCIAL-EMOTIONAL"
paste(names(scores_par_prelim_wide[13:18]), collapse = ", ")

[1] "get hurt feelings, feel guilty, feel sad, feel proud, feel shy, feel love"

alpha(scores_par_prelim_wide[13:18])$total

ggplot(scores_par, aes(x = target, y = score, color = factor)) +
  facet_grid(cols = vars(site, age), rows = vars(factor)) +
  geom_jitter(height = 0.02, width = 0.2, alpha = 0.2, show.legend = F) +
  geom_pointrange(data = scores_par_mb,
                  aes(y = mean, ymin = ci_lower, ymax = ci_upper),
                  fatten = 2, color = "black") +
  scale_color_brewer(palette = "Set1") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))

ggplot(scores_par %>%
         mutate(factor_short = recode_factor(
           factor,
           "BODILY" = "BOD.",
           "COGNITIVE" = "COG.",
           "SOCIAL-EMOTIONAL" = "SOC.-EMO.")) %>%
         filter(target %in% c("children", "ghosts", "God")), 
       aes(x = target, y = score, color = factor_short)) +
  facet_grid(cols = vars(site, age), rows = vars(factor_short)) +
  geom_jitter(height = 0.02, width = 0.2, alpha = 0.25, show.legend = F) +
  geom_pointrange(data = scores_par_mb %>%
                    mutate(factor_short = recode_factor(
                      factor,
                      "BODILY" = "BOD.",
                      "COGNITIVE" = "COG.",
                      "SOCIAL-EMOTIONAL" = "SOC.-EMO.")) %>%
                    filter(target %in% c("children", "ghosts", "God")),
                  aes(y = mean, ymin = ci_lower, ymax = ci_upper),
                  fatten = 2, color = "black") +
  scale_color_brewer(palette = "Set1") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))

Minimizing BIC

How many factors to retain?

reten_all_BIC <- VSS(d_all, plot = F); reten_all_BIC

Very Simple Structure
Call: vss(x = x, n = n, rotate = rotate, diagonal = diagonal, fm = fm, 
    n.obs = n.obs, plot = plot, title = title, use = use, cor = cor)
VSS complexity 1 achieves a maximimum of 0.91  with  1  factors
VSS complexity 2 achieves a maximimum of 0.94  with  2  factors

The Velicer MAP achieves a minimum of 0.01  with  3  factors 
BIC achieves a minimum of  -616.49  with  4  factors
Sample Size adjusted BIC achieves a minimum of  -171.4  with  7  factors

Statistics by number of factors 

reten_all_bic <- data.frame(reten_all_BIC$vss.stats %>% rownames_to_column("nfact") %>% top_n(-1, BIC))$nfact %>% as.numeric()

Preset criteria

How many factors to retain?

reten_all_k <- reten_fun(d_all, rot_type = "varimax"); reten_all_k

[1] 2

What are these factors?

efa_all_k <- fa(d_all, nfactors = reten_all_k, rotate = "varimax",
                scores = "tenBerge", impute = "median")

heatmap_fun(efa_all_k) + 
  labs(title = "Preset criteria (Weisman et al., 2017)")

Joining, by = "capacity"
Joining, by = "factor"

Which capacities are attributed to which targets?

scoresplot_fun(efa_all_k, target = "all") + 
  labs(title = "Preset criteria (Weisman et al., 2017)")

Ignoring unknown aesthetics: y

scoresplot_fun(efa_all_k, target = c("ghosts", "God", "children")) + 
  labs(title = "Preset criteria (Weisman et al., 2017)")

the condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedIgnoring unknown aesthetics: y

itemsplot_fun(efa_all_k, target = c("ghosts", "God", "children")) + 
  labs(title = "Preset criteria (Weisman et al., 2017)")

the condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedJoining, by = "capacity"

|===============                                   | 31% ~4 s remaining     
|================                                  | 32% ~4 s remaining     
|================                                  | 33% ~4 s remaining     
|================                                  | 34% ~4 s remaining     
|=================                                 | 35% ~4 s remaining     
|=================                                 | 35% ~4 s remaining     
|==================                                | 36% ~4 s remaining     
|==================                                | 38% ~4 s remaining     
|===================                               | 39% ~4 s remaining     
|===================                               | 39% ~4 s remaining     
|===================                               | 40% ~4 s remaining     
|====================                              | 40% ~4 s remaining     
|====================                              | 41% ~4 s remaining     
|====================                              | 42% ~4 s remaining     
|=====================                             | 43% ~4 s remaining     
|=====================                             | 44% ~4 s remaining     
|======================                            | 45% ~4 s remaining     
|======================                            | 45% ~4 s remaining     
|======================                            | 46% ~4 s remaining     
|=======================                           | 46% ~4 s remaining     
|=======================                           | 47% ~3 s remaining     
|========================                          | 48% ~3 s remaining     
|========================                          | 49% ~3 s remaining     
|========================                          | 49% ~3 s remaining     
|=========================                         | 50% ~3 s remaining     
|=========================                         | 51% ~3 s remaining     
|=========================                         | 52% ~3 s remaining     
|==========================                        | 52% ~3 s remaining     
|==========================                        | 53% ~3 s remaining     
|==========================                        | 54% ~3 s remaining     
|===========================                       | 55% ~3 s remaining     
|===========================                       | 55% ~3 s remaining     
|===========================                       | 55% ~3 s remaining     
|============================                      | 56% ~3 s remaining     
|============================                      | 57% ~3 s remaining     
|============================                      | 58% ~3 s remaining     
|=============================                     | 59% ~3 s remaining     
|=============================                     | 59% ~3 s remaining     
|=============================                     | 60% ~3 s remaining     
|==============================                    | 60% ~3 s remaining     
|==============================                    | 61% ~3 s remaining     
|===============================                   | 62% ~3 s remaining     
|===============================                   | 63% ~3 s remaining     
|===============================                   | 63% ~3 s remaining     
|================================                  | 64% ~2 s remaining     
|================================                  | 65% ~2 s remaining     
|================================                  | 66% ~2 s remaining     
|=================================                 | 66% ~2 s remaining     
|=================================                 | 67% ~2 s remaining     
|=================================                 | 68% ~2 s remaining     
|==================================                | 68% ~2 s remaining     
|==================================                | 69% ~2 s remaining     
|===================================               | 70% ~2 s remaining     
|===================================               | 71% ~2 s remaining     
|====================================              | 73% ~2 s remaining     
|====================================              | 74% ~2 s remaining     
|=====================================             | 74% ~2 s remaining     
|=====================================             | 75% ~2 s remaining     
|=====================================             | 76% ~2 s remaining     
|======================================            | 77% ~2 s remaining     
|======================================            | 78% ~2 s remaining     
|=======================================           | 78% ~1 s remaining     
|=======================================           | 79% ~1 s remaining     
|=======================================           | 80% ~1 s remaining     
|========================================          | 80% ~1 s remaining     
|========================================          | 81% ~1 s remaining     
|=========================================         | 82% ~1 s remaining     
|=========================================         | 83% ~1 s remaining     
|=========================================         | 84% ~1 s remaining     
|==========================================        | 84% ~1 s remaining     
|==========================================        | 84% ~1 s remaining     
|==========================================        | 85% ~1 s remaining     
|==========================================        | 86% ~1 s remaining     
|===========================================       | 87% ~1 s remaining     
|===========================================       | 88% ~1 s remaining     
|============================================      | 88% ~1 s remaining     
|============================================      | 89% ~1 s remaining     
|============================================      | 90% ~1 s remaining     
|=============================================     | 91% ~1 s remaining     
|=============================================     | 91% ~1 s remaining     
|=============================================     | 92% ~1 s remaining     
|==============================================    | 93% ~1 s remaining     
|==============================================    | 94% ~0 s remaining     
|===============================================   | 94% ~0 s remaining     
|===============================================   | 95% ~0 s remaining     
|===============================================   | 95% ~0 s remaining     
|================================================  | 96% ~0 s remaining     
|================================================  | 97% ~0 s remaining     
|================================================  | 98% ~0 s remaining     
|================================================= | 98% ~0 s remaining     
|================================================= | 99% ~0 s remaining     
|================================================= |100% ~0 s remaining     
|==================================================|100% ~0 s remaining     

Joining, by = c("factor", "capacity", "order")

3 factors

What are these factors?

efa_all_3 <- fa(d_all, nfactors = 3, rotate = "varimax",
                scores = "tenBerge", impute = "median")
efa_all_3_factornames <- c("BODILY", "COGNITIVE", "SOCIAL-EMOTIONAL")
efa_all_3_factornames_short <- c("BOD.", "COG.", "SOC.-EMO.")

heatmap_fun(efa_all_3, factor_names = efa_all_3_factornames) + 
  labs(x = "Shared concpetual structure") +
  theme(axis.title.x = element_text(hjust = 0))

the condition has length > 1 and only the first element will be usedJoining, by = "capacity"
Joining, by = "factor"

# labs(title = "Preset criteria (Weisman et al., 2017)")

Which capacities are attributed to which targets?

scoresplot_fun(efa_all_3, target = "all", highlight = "supernatural",
               factor_names = efa_all_3_factornames) +
  # scale_fill_manual(values = c("#e41a1c", "#4daf4a", "#377eb8")) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 1,
                                   color = c(rep("black", 8),
                                             rep("#984ea3", 2)),
                                   face = c(rep("plain", 8),
                                            rep("bold", 2))))

the condition has length > 1 and only the first element will be used

|==============================================    | 93% ~0 s remaining     
|===============================================   | 95% ~0 s remaining     
|================================================= | 98% ~0 s remaining     

Ignoring unknown aesthetics: y

scoresplot_fun(efa_all_3, target = c("ghosts", "God", "children"), 
               factor_names = efa_all_3_factornames_short) + 
  labs(title = "Preset criteria (Weisman et al., 2017)")

the condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedIgnoring unknown aesthetics: y

itemsplot_fun(efa_all_3, target = c("ghosts", "God", "children"),
              factor_names = efa_all_3_factornames) + 
  labs(title = "Preset criteria (Weisman et al., 2017)")

the condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedthe condition has length > 1 and only the first element will be usedJoining, by = "capacity"
the condition has length > 1 and only the first element will be used

|===========================                       | 55% ~2 s remaining     
|============================                      | 56% ~2 s remaining     
|============================                      | 57% ~2 s remaining     
|============================                      | 58% ~2 s remaining     
|=============================                     | 59% ~2 s remaining     
|=============================                     | 59% ~2 s remaining     
|=============================                     | 59% ~2 s remaining     
|=============================                     | 60% ~2 s remaining     
|==============================                    | 61% ~2 s remaining     
|===============================                   | 62% ~2 s remaining     
|================================                  | 64% ~1 s remaining     
|================================                  | 65% ~1 s remaining     
|================================                  | 66% ~1 s remaining     
|=================================                 | 67% ~1 s remaining     
|==================================                | 68% ~1 s remaining     
|==================================                | 69% ~1 s remaining     
|===================================               | 70% ~1 s remaining     
|===================================               | 71% ~1 s remaining     
|===================================               | 72% ~1 s remaining     
|====================================              | 72% ~1 s remaining     
|====================================              | 73% ~1 s remaining     
|=====================================             | 74% ~1 s remaining     
|=====================================             | 75% ~1 s remaining     
|======================================            | 76% ~1 s remaining     
|======================================            | 78% ~1 s remaining     
|=======================================           | 79% ~1 s remaining     
|========================================          | 80% ~1 s remaining     
|========================================          | 81% ~1 s remaining     
|=========================================         | 82% ~1 s remaining     
|=========================================         | 83% ~1 s remaining     
|==========================================        | 84% ~1 s remaining     
|==========================================        | 85% ~1 s remaining     
|==========================================        | 86% ~1 s remaining     
|===========================================       | 87% ~1 s remaining     
|===========================================       | 87% ~1 s remaining     
|===========================================       | 88% ~1 s remaining     
|============================================      | 88% ~1 s remaining     
|============================================      | 89% ~1 s remaining     
|============================================      | 90% ~0 s remaining     
|=============================================     | 91% ~0 s remaining     
|==============================================    | 92% ~0 s remaining     
|==============================================    | 93% ~0 s remaining     
|===============================================   | 94% ~0 s remaining     
|===============================================   | 95% ~0 s remaining     
|================================================  | 96% ~0 s remaining     
|================================================  | 97% ~0 s remaining     
|================================================= | 98% ~0 s remaining     
|================================================= | 99% ~0 s remaining     
|================================================= |100% ~0 s remaining     

Joining, by = c("factor", "capacity", "order")

Comparing conceptual structures

4 factors

We’ll extract 4 factors from all samples, to keep things simple.

efa_us_ad_4 <- fa(d_us_ad, nfactors = 4, rotate = "varimax")
efa_us_ch_4 <- fa(d_us_ch, nfactors = 4, rotate = "varimax")
efa_gh_ad_4 <- fa(d_gh_ad, nfactors = 4, rotate = "varimax")
efa_gh_ch_4 <- fa(d_gh_ch_fante, nfactors = 4, rotate = "varimax")
efa_th_ad_4 <- fa(d_th_ad, nfactors = 4, rotate = "varimax")
efa_th_ch_4 <- fa(d_th_ch, nfactors = 4, rotate = "varimax")
efa_vt_ad_4 <- fa(d_vt_ad, nfactors = 4, rotate = "varimax")
efa_vt_ch_4 <- fa(d_vt_ch, nfactors = 4, rotate = "varimax")

plot_us_ad_4 <- heatmap_fun(efa_us_ad_4) + 
  guides(fill = "none") + 
  labs(x = "US: adults") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_us_ch_4 <- heatmap_fun(efa_us_ch_4) + 
  guides(fill = "none") + 
  labs(x = "US: children") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_gh_ad_4 <- heatmap_fun(efa_gh_ad_4) + 
  guides(fill = "none") + 
  labs(x = "Ghana: adults") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_gh_ch_4 <- heatmap_fun(efa_gh_ch_4) + 
  guides(fill = "none") + 
  labs(x = "Ghana: children") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_th_ad_4 <- heatmap_fun(efa_th_ad_4) + 
  guides(fill = "none") + 
  labs(x = "Thailand: adults") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_th_ch_4 <- heatmap_fun(efa_th_ch_4) + 
  guides(fill = "none") + 
  labs(x = "Thailand: children") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_vt_ad_4 <- heatmap_fun(efa_vt_ad_4) + 
  guides(fill = "none") + 
  labs(x = "Vanuatu: adults") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_vt_ch_4 <- heatmap_fun(efa_vt_ch_4) + 
  guides(fill = "none") + 
  labs(x = "Vanuatu: children") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_grid(plot_us_ad_4, plot_us_ch_4, 
          plot_gh_ad_4, plot_gh_ch_4, 
          plot_th_ad_4, plot_th_ch_4, 
          plot_vt_ad_4, plot_vt_ch_4, 
          ncol = 2, labels = "AUTO")

3 factors

We’ll extract 3 factors from all samples, to keep things simple.

efa_us_ad_3 <- fa(d_us_ad, nfactors = 3, rotate = "varimax")
efa_us_ch_3 <- fa(d_us_ch, nfactors = 3, rotate = "varimax")
efa_gh_ad_3 <- fa(d_gh_ad, nfactors = 3, rotate = "varimax")
efa_gh_ch_3 <- fa(d_gh_ch_fante, nfactors = 3, rotate = "varimax")
efa_th_ad_3 <- fa(d_th_ad, nfactors = 3, rotate = "varimax")
efa_th_ch_3 <- fa(d_th_ch, nfactors = 3, rotate = "varimax")
efa_vt_ad_3 <- fa(d_vt_ad, nfactors = 3, rotate = "varimax")
efa_vt_ch_3 <- fa(d_vt_ch, nfactors = 3, rotate = "varimax")

plot_us_ad_3 <- heatmap_fun(efa_us_ad_3) + 
  guides(fill = "none") + 
  labs(x = "US: adults") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_us_ch_3 <- heatmap_fun(efa_us_ch_3) + 
  guides(fill = "none") + 
  labs(x = "US: children") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_gh_ad_3 <- heatmap_fun(efa_gh_ad_3) + 
  guides(fill = "none") + 
  labs(x = "Ghana: adults") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_gh_ch_3 <- heatmap_fun(efa_gh_ch_3) + 
  guides(fill = "none") + 
  labs(x = "Ghana: children") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_th_ad_3 <- heatmap_fun(efa_th_ad_3) + 
  guides(fill = "none") + 
  labs(x = "Thailand: adults") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_th_ch_3 <- heatmap_fun(efa_th_ch_3) + 
  guides(fill = "none") + 
  labs(x = "Thailand: children") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_vt_ad_3 <- heatmap_fun(efa_vt_ad_3) + 
  guides(fill = "none") + 
  labs(x = "Vanuatu: adults") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_vt_ch_3 <- heatmap_fun(efa_vt_ch_3) + 
  guides(fill = "none") + 
  labs(x = "Vanuatu: children") +
  theme(axis.title.x = element_text(hjust = 0))

Joining, by = "capacity"
Joining, by = "factor"

plot_grid(plot_us_ad_3, plot_us_ch_3, 
          plot_gh_ad_3, plot_gh_ch_3, 
          plot_th_ad_3, plot_th_ch_3, 
          plot_vt_ad_3, plot_vt_ch_3, 
          ncol = 2, labels = "AUTO")

Counts

paste("US adults:", nrow(d_us_ad))

[1] "US adults: 127"

paste("US children:", nrow(d_us_ch))

[1] "US children: 117"

paste("GH adults:", nrow(d_gh_ad))

[1] "GH adults: 150"

paste("GH children:", nrow(d_gh_ch))

[1] "GH children: 149"

paste("TH adults:", nrow(d_th_ad))

[1] "TH adults: 150"

paste("TH children:", nrow(d_th_ch))

[1] "TH children: 152"

paste("VT adults:", nrow(d_vt_ad))

[1] "VT adults: 164"

paste("VT children:", nrow(d_vt_ch))

[1] "VT children: 169"

paste("Non-US:", sum(nrow(d_gh_ad), nrow(d_gh_ch),
                     nrow(d_th_ad), nrow(d_th_ch),
                     nrow(d_vt_ad), nrow(d_vt_ch)))

[1] "Non-US: 934"

paste0("Adults: n = ", min(nrow(d_us_ad), nrow(d_gh_ad), nrow(d_th_ad), nrow(d_vt_ad)), "-", max(nrow(d_us_ad), nrow(d_gh_ad), nrow(d_th_ad), nrow(d_vt_ad)), "; total N = ",  sum(nrow(d_us_ad), nrow(d_gh_ad), nrow(d_th_ad), nrow(d_vt_ad)))

[1] "Adults: n = 127-164; total N = 591"

paste0("Children: n = ", min(nrow(d_us_ch), nrow(d_gh_ch), nrow(d_th_ch), nrow(d_vt_ch)), "-", max(nrow(d_us_ch), nrow(d_gh_ch), nrow(d_th_ch), nrow(d_vt_ch)), "; total N = ",  sum(nrow(d_us_ch), nrow(d_gh_ch), nrow(d_th_ch), nrow(d_vt_ch)))

[1] "Children: n = 117-169; total N = 587"

d_all %>%
  rownames_to_column("site_age_subid_target_character") %>%
  mutate(site_age_subid_target_character = gsub("cell phones", "cellphones", site_age_subid_target_character)) %>%
  separate(site_age_subid_target_character, into = c("site", "age", "subid", "target", "character")) %>%
  count(site, age, character) %>%
  spread(character, n)

d_all %>%
  rownames_to_column("site_age_subid_target_character") %>%
  mutate(site_age_subid_target_character = gsub("cell phones", "cellphones", site_age_subid_target_character)) %>%
  separate(site_age_subid_target_character, into = c("site", "age", "subid", "target", "character")) %>%
  filter(is.na(character) | character == "NA")